home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1992 June: ROMin Holiday / ADC Developer CD (1992-06) (''ROMin Holiday'')_iso / Developer Connection - 06-1992.iso / Development Platforms / LISP Related / MCL 2.0b1 Patches / MCL 2.0b1 Source Patches / grow-icon-source-patch.lisp < prev    next >
Encoding:
Text File  |  1991-04-02  |  2.7 KB  |  65 lines  |  [TEXT/CCL2]
  1. ; grow-icon-source-patch.lisp
  2. ; This source patch is included in the MCL 2.0b1 patch (.fasl) files. The 
  3. ; following source patch is provided so that the source in the library file is 
  4. ; consistent with the behavior of MCL 2.0b1p2.
  5.  
  6.  
  7. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  8. ;;
  9. ;; These are from library;scroll-bar-dialog-items.lisp
  10.  
  11. (defmethod view-draw-contents ((item scroll-bar-dialog-item))
  12.   (let ((handle (dialog-item-handle item)))
  13.     (when handle
  14.       (if (window-active-p (view-window item))
  15.         (if (rref handle :control.vis)
  16.           (_Draw1Control :ptr handle)
  17.           (_ShowControl :ptr handle))
  18.         (multiple-value-bind (tl br) (scroll-bar-and-splitter-corners item)
  19.           (rlet ((rect :rect :topLeft tl :botRight br))
  20.             (_FrameRect :ptr rect)))))))
  21.  
  22. (defun scroll-bar-and-splitter-corners (scroll-bar)
  23.   (multiple-value-bind (tl br) (view-corners scroll-bar)
  24.     (let ((splitter (pane-splitter scroll-bar)))
  25.       (if splitter
  26.         (multiple-value-bind (stl sbr) (view-corners splitter)
  27.           (values (make-point (min (point-h tl) (point-h stl))
  28.                               (min (point-v tl) (point-v stl)))
  29.                   (make-point (max (point-h br) (point-h sbr))
  30.                               (max (point-v br) (point-v sbr)))))
  31.         (values tl br)))))
  32.  
  33.  
  34. (defmethod view-deactivate-event-handler ((item scroll-bar-dialog-item))
  35.   (with-focused-view (view-container item)
  36.     (let ((handle (dialog-item-handle item)))
  37.       (unless (window-active-p (view-window item))
  38.         (multiple-value-bind (tl br) (scroll-bar-and-splitter-corners item)
  39.           (rlet ((rect :rect
  40.                        :topLeft (add-points tl #@(1 1))
  41.                        :botRight (subtract-points br #@(1 1))))
  42.             (with-clip-rect rect
  43.               (_HideControl :ptr handle)
  44.               (_EraseRect :ptr rect)))))
  45.       (_hilitecontrol :ptr handle :word 255))))
  46.  
  47. (defmethod view-activate-event-handler ((item scroll-bar-dialog-item))
  48.   (when (let ((w (view-window item)))
  49.           (and w (window-active-p w)))
  50.     (let ((handle (dialog-item-handle item)))
  51.       (with-focused-view (view-container item)
  52.         (when (dialog-item-enabled-p item)
  53.           (_hilitecontrol :ptr handle :word 0))
  54.         (unless (rref handle :control.vis)
  55.           (_ShowControl :ptr handle)
  56.           (let ((splitter (pane-splitter item)))
  57.             (when splitter (view-draw-contents splitter))))))))
  58.  
  59. (defmethod view-draw-contents ((item pane-splitter))
  60.   (when (window-active-p (view-window item))
  61.     (let* ((tl (view-position item))
  62.            (br (add-points tl (view-size item))))
  63.       (rlet ((r :rect :topleft tl :botright br))
  64.         (_FillRect :ptr r :ptr *black-pattern*)))))
  65.